home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
ctlib100.zip
/
INSTALL.LZH
/
READERS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-10-12
|
29KB
|
730 lines
{**************************************************************************}
{* BitSoft Development, L.L.C. *}
{* Copyright (C) 1995, 1996 BitSoft Development, L.L.C. *}
{* All rights reserved. *}
{**************************************************************************}
unit Readers;
{$B-,T-}
interface
uses Objects, Views,
Containr, ctTrees, ctLists;
var
Packing : Boolean;
type
{ Base reader }
PContainerReader = ^TContainerReader;
TContainerReader = object(TObject)
Container : PContainer;
Owner : PScroller;
HasChanged : Boolean;
constructor Init(AContainer : PContainer);
destructor Done; virtual;
function Count : string; virtual;
function ExtractIndex(Item : Pointer) : Integer; virtual;
function ExtractText(Item : Pointer) : PString; virtual;
function GetText(Index : LongInt) : string; virtual;
function OtherInfo : string; virtual;
procedure ShowItem(Item : Pointer);
end; { TContainerReader }
type
{ Reader for stream based sequences }
PSequenceReader = ^TSequenceReader;
TSequenceReader = object(TContainerReader)
function GetText(Index : LongInt) : string; virtual;
end; { TStreamSequenceReader }
type
{ Reader for containers using TNode descendants }
PNodeDataReader = ^TNodeDataReader;
TNodeDataReader = object(TContainerReader)
function ExtractText(Item : Pointer) : PString; virtual;
end; { TNodeDataReader }
type
{ Reader for linked lists }
PListReader = ^TListReader;
TListReader = object(TNodeDataReader)
First : PListNode;
LowIndex : LongInt;
constructor Init(List : PList);
function GetText(Index : LongInt) : string; virtual;
end; { TListReader }
type
{ Reader for memory trees }
PMemTreeReader = ^TMemTreeReader;
TMemTreeReader = object(TNodeDataReader)
First : PNode;
LowIndex : LongInt;
constructor Init(AContainer : PContainer);
function GetText(Index : LongInt) : string; virtual;
function OtherInfo : string; virtual;
end; { TMemTreeReader }
{ Data specific readers }
type
PTestRecReader = ^TTestRecReader;
TTestRecReader = object(TSequenceReader)
function ExtractText (Item : Pointer) : PString; virtual;
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestRec }
type
PTestObjectReader = ^TTestObjectReader;
TTestObjectReader = object(TSequenceReader)
function ExtractText (Item : Pointer) : PString; virtual;
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestObjectReader }
type
PTestStaticObjectReader = ^TTestStaticObjectReader;
TTestStaticObjectReader = object(TSequenceReader)
function ExtractText (Item : Pointer) : PString; virtual;
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestStaticObjectReader }
type
PStringReader = ^TStringReader;
TStringReader = object(TSequenceReader)
function ExtractText (Item : Pointer) : PString; virtual;
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TStringReader }
type
PTestListNodeReader = ^TTestListNodeReader;
TTestListNodeReader = object(TListReader)
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestListNodeReader }
type
PTestDoubleNodeReader = ^TTestDoubleNodeReader;
TTestDoubleNodeReader = object(TListReader)
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestDoubleNodeReader }
type
PTestBinaryNodeReader = ^TTestBinaryNodeReader;
TTestBinaryNodeReader = object(TMemTreeReader)
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestBinaryNodeReader }
type
PTestAvlNodeReader = ^TTestAvlNodeReader;
TTestAvlNodeReader = object(TMemTreeReader)
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TTestAvlNodeReader }
type
PBTreeReader = ^TBTreeReader;
TBTreeReader = object(TContainerReader)
FirstKey : string[8];
LowIndex : LongInt;
constructor Init(AContainer : PContainer);
function GetText(Index : LongInt) : string; virtual;
function ExtractText (Item : Pointer) : PString; virtual;
function ExtractIndex (Item : Pointer) : Integer; virtual;
function OtherInfo : string; virtual;
end; { TBTreeReader }
type
PObjectBTreeReader = ^TObjectBTreeReader;
TObjectBTreeReader = object(TBTreeReader)
function ExtractText (Item : Pointer) : PString; virtual;
function ExtractIndex (Item : Pointer) : Integer; virtual;
end; { TObjectBTreeReader }
implementation
uses ctCollec, ctBiTree,
Utils, Data;
{****************************************************************************}
{ TBTreeReader object }
{****************************************************************************}
{****************************************************************************}
{ TBTreeReader.Init }
{****************************************************************************}
constructor TBTreeReader.Init(AContainer : PContainer);
begin
TContainerReader.Init(AContainer);
FirstKey := '';
LowIndex := 0;
end;
{****************************************************************************}
{ TBTreeReader.GetText }
{****************************************************************************}
function TBTreeReader.GetText(Index : LongInt) : string;
var
CurrNode : PNode;
CurrIndex : LongInt;
StrIndex : string;
First : Pointer;
procedure SetFirstKey(Item : Pointer);
begin
FirstKey := ExtractText(Item)^;
end; { SetFirstKey }
procedure SetFirst;
var
CurrNodeIndex : LongInt;
function MatchIndexInc(Item: Pointer) : Boolean; far;
begin
if CurrNodeIndex = Owner^.Delta.Y
then MatchIndexInc := True
else MatchIndexInc := False;
Inc(CurrNodeIndex);
end; { MatchIndex }
function MatchIndexDec(Item: Pointer) : Boolean; far;
begin
if CurrNodeIndex = Owner^.Delta.Y
then MatchIndexDec := True
else MatchIndexDec := False;
Dec(CurrNodeIndex);
end; { MatchIndex }
begin
if Index <= (Container^.Count div 2)
then begin
CurrNodeIndex := 0;
SetFirstKey(PGraph(Container)^.FirstThat(@MatchIndexInc))
end { if }
else begin
CurrNodeIndex := Pred(Container^.Count);
SetFirstKey(PGraph(Container)^.LastThat(@MatchIndexDec))
end; { else }
First := PGraph(Container)^.KeyFirst(@FirstKey);
HasChanged := False;
end; { SetFirst }
begin
if (Container = nil) or (Index >= Container^.Count)
then GetText := ''
else begin
PGraph(Container)^.ExactMatch := False;
if (FirstKey = '') or HasChanged
then SetFirst
else if Owner^.Delta.Y < LowIndex
then if (LowIndex - Owner^.Delta.Y) < Owner^.Delta.Y
then begin
First := PGraph(Container)^.KeyFirst(@FirstKey);
while LowIndex <> Owner^.Delta.Y do
begin
First := PGraph(Container)^.Prev(First);
Dec(LowIndex);
end; { while }
SetFirstKey(First);
end { if }
else SetFirst
else if Owner^.Delta.Y > LowIndex
then if (Owner^.Delta.Y - LowIndex) < (Pred(Container^.Count) -
Owner^.Delta.Y)
then begin
First := PGraph(Container)^.KeyFirst(@FirstKey);
while LowIndex <> Owner^.Delta.Y do
begin
First := PGraph(Container)^.Next(First);
Inc(LowIndex);
end; { while }
SetFirstKey(First);
end { if }
else SetFirst
else First := PGraph(Container)^.KeyFirst(@FirstKey);
LowIndex := Owner^.Delta.Y;
CurrIndex := LowIndex;
CurrNode := First;
while CurrIndex <> Index do
begin
CurrNode := PGraph(Container)^.Next(CurrNode);
Inc(CurrIndex);
end; { while }
Str(Index, StrIndex);
if ExtractText(CurrNode) <> nil
then GetText := ExtractText(CurrNode)^+' ['+StrIndex+']'
else GetText := 'n/a ['+StrIndex+']';
end; { else }
end;
{****************************************************************************}
{ TBTreeReader.ExtractText }
{****************************************************************************}
function TBTreeReader.ExtractText(Item : Pointer) : PString;
begin
if Item <> nil
then ExtractText := @(PTestRec(Item)^.Key)
else ExtractText := nil;
end;
{****************************************************************************}
{ TBTreeReader.ExtractIndex }
{****************************************************************************}
function TBTreeReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestRec(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TBTreeReader.OtherInfo }
{****************************************************************************}
function TBTreeReader.OtherInfo : string;
var
HeightStr : string;
begin
if Container <> nil
then Str(PTree(Container)^.Height, HeightStr)
else HeightStr := 'n/a';
OtherInfo := 'Height: '+HeightStr;
end;
{****************************************************************************}
{ TContainerReader object }
{****************************************************************************}
{****************************************************************************}
{ TContainerReader.Init }
{****************************************************************************}
constructor TContainerReader.Init(AContainer : PContainer);
begin
TObject.Init;
Container := AContainer;
Owner := nil;
HasChanged := False;
end;
{****************************************************************************}
{ TContainerReader.Done }
{****************************************************************************}
destructor TContainerReader.Done;
begin
if Container <> nil
then Dispose(Container, Done);
TObject.Done;
end;
{****************************************************************************}
{ TContainerReader.Count }
{****************************************************************************}
function TContainerReader.Count : string;
var
CountStr : string;
begin
if Container <> nil
then Str(Container^.Count, CountStr)
else CountStr := 'n/a';
Count := CountStr;
end;
{****************************************************************************}
{ TContainerReader.ExtractIndex }
{****************************************************************************}
function TContainerReader.ExtractIndex(Item : Pointer) : Integer;
begin
Abstract;
end;
{****************************************************************************}
{ TContainerReader.ExtractText }
{****************************************************************************}
function TContainerReader.ExtractText(Item : Pointer) : PString;
begin
Abstract;
end;
{****************************************************************************}
{ TContainerReader.GetText }
{****************************************************************************}
function TContainerReader.GetText(Index : LongInt) : string;
begin
Abstract;
end;
{****************************************************************************}
{ TContainerReader.OtherInfo }
{****************************************************************************}
function TContainerReader.OtherInfo : string;
begin
OtherInfo := '';
end;
{****************************************************************************}
{ TContainerReader }
{****************************************************************************}
procedure TContainerReader.ShowItem(Item : Pointer);
var
StrIndex : string;
begin
Str(ExtractIndex(Item), StrIndex);
if ExtractText(Item) <> nil
then Writeln(TestWindow^.T, ExtractText(Item)^ + ' (' + StrIndex +
')':13)
else Writeln(TestWindow^.T, '(' + StrIndex + ')':13);
end;
{****************************************************************************}
{ TListReader object }
{****************************************************************************}
{****************************************************************************}
{ TListReader.Init }
{****************************************************************************}
constructor TListReader.Init(List : PList);
begin
TContainerReader.Init(List);
First := nil;
LowIndex := 0;
end;
{****************************************************************************}
{ TListReader.GetText }
{****************************************************************************}
function TListReader.GetText(Index : LongInt) : string;
var
CurrNode : PListNode;
CurrIndex : LongInt;
StrIndex : string;
begin
if (Container = nil) or (Index >= Container^.Count)
then GetText := ''
else begin
if (First = nil) or HasChanged or (Owner^.Delta.Y <> LowIndex)
then begin
First := PSequence(Container)^.At(Index);
LowIndex := Owner^.Delta.Y;
HasChanged := False;
end; { if }
CurrIndex := LowIndex;
CurrNode := First;
while CurrIndex <> Index do
begin
CurrNode := PListNode(CurrNode)^.Next;
Inc(CurrIndex);
end; { while }
Str(Index, StrIndex);
if ExtractText(CurrNode) <> nil
then GetText := ExtractText(CurrNode)^+' ['+StrIndex+']'
else GetText := 'n/a ['+StrIndex+']'
end; { else }
end;
{****************************************************************************}
{ TMemTreeReader object }
{****************************************************************************}
{****************************************************************************}
{ TMemTreeReader.Init }
{****************************************************************************}
constructor TMemTreeReader.Init(AContainer : PContainer);
begin
TContainerReader.Init(AContainer);
First := nil;
LowIndex := 0;
end;
{****************************************************************************}
{ TMemTreeReader.GetText }
{****************************************************************************}
function TMemTreeReader.GetText(Index : LongInt) : string;
var
CurrNode : PNode;
CurrIndex : LongInt;
StrIndex : string;
procedure SetFirst;
var
CurrNodeIndex : LongInt;
function MatchIndexInc(Item: Pointer) : Boolean; far;
begin
if CurrNodeIndex = Owner^.Delta.Y
then MatchIndexInc := True
else MatchIndexInc := False;
Inc(CurrNodeIndex);
end; { MatchIndex }
function MatchIndexDec(Item: Pointer) : Boolean; far;
begin
if CurrNodeIndex = Owner^.Delta.Y
then MatchIndexDec := True
else MatchIndexDec := False;
Dec(CurrNodeIndex);
end; { MatchIndex }
begin
if Index <= (Container^.Count div 2)
then begin
CurrNodeIndex := 0;
First := PGraph(Container)^.FirstThat(@MatchIndexInc);
end { if }
else begin
CurrNodeIndex := Pred(Container^.Count);
First := PGraph(Container)^.LastThat(@MatchIndexDec);
end; { else }
HasChanged := False;
end; { SetFirst }
begin
if (Container = nil) or (Index >= Container^.Count)
then GetText := ''
else begin
PGraph(Container)^.ExactMatch := False;
if (First = nil) or HasChanged
then SetFirst
else if Owner^.Delta.Y < LowIndex
then if (LowIndex - Owner^.Delta.Y) < Owner^.Delta.Y
then while LowIndex <> Owner^.Delta.Y do
begin
First := PGraph(Container)^.Prev(First);
Dec(LowIndex);
end { while }
else SetFirst
else if Owner^.Delta.Y > LowIndex
then if (Owner^.Delta.Y - LowIndex) < (Pred(Container^.Count) -
Owner^.Delta.Y)
then while LowIndex <> Owner^.Delta.Y do
begin
First := PGraph(Container)^.Next(First);
Inc(LowIndex);
end { while }
else SetFirst;
LowIndex := Owner^.Delta.Y;
CurrIndex := LowIndex;
CurrNode := First;
while CurrIndex <> Index do
begin
CurrNode := PGraph(Container)^.Next(CurrNode);
Inc(CurrIndex);
end; { while }
Str(Index, StrIndex);
if ExtractText(CurrNode) <> nil
then GetText := ExtractText(CurrNode)^+' ['+StrIndex+']'
else GetText := 'n/a ['+StrIndex+']';
end; { else }
end;
{****************************************************************************}
{ TMemTreeReader.OtherInfo }
{****************************************************************************}
function TMemTreeReader.OtherInfo : string;
var
HeightStr : string;
begin
Str(PBinaryTree(Container)^.Height, HeightStr);
OtherInfo := 'Height: '+HeightStr;
end;
{****************************************************************************}
{ TNodeDataReader object }
{****************************************************************************}
{****************************************************************************}
{ TNodeDataReader.ExtractText }
{****************************************************************************}
function TNodeDataReader.ExtractText(Item : Pointer) : PString;
begin
if Item <> nil
then ExtractText := PNode(Item)^.KeyOf
else ExtractText := nil;
end;
{****************************************************************************}
{ TObjectBTreeReader object }
{****************************************************************************}
{****************************************************************************}
{ TObjectBTreeReader.ExtractText }
{****************************************************************************}
function TObjectBTreeReader.ExtractText(Item : Pointer) : PString;
begin
if Item <> nil
then ExtractText := @(PTestStaticObject(Item)^.Text)
else ExtractText := nil;
end;
{****************************************************************************}
{ TObjectBTreeReader.ExtractIndex }
{****************************************************************************}
function TObjectBTreeReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestStaticObject(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestAvlNodeReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestAvlNodeReader.ExtractIndex }
{****************************************************************************}
function TTestAvlNodeReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestAvlNode(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestBinaryNodeReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestBinaryNodeReader.ExtractIndex }
{****************************************************************************}
function TTestBinaryNodeReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestBinaryNode(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestDoubleNodeReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestDoubleNodeReader.ExtractIndex }
{****************************************************************************}
function TTestDoubleNodeReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestDoubleNode(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestListNodeReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestListNodeReader.ExtractIndex }
{****************************************************************************}
function TTestListNodeReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestListNode(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestObjectReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestObjectReader.ExtractText }
{****************************************************************************}
function TTestObjectReader.ExtractText(Item : Pointer) : PString;
begin
if Item <> nil
then ExtractText := PTestObject(Item)^.Text
else ExtractText := nil;
end;
{****************************************************************************}
{ TTestObjectReader.ExtractIndex }
{****************************************************************************}
function TTestObjectReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestObject(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestRecReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestRecReader.ExtractText }
{****************************************************************************}
function TTestRecReader.ExtractText(Item : Pointer) : PString;
begin
if Item <> nil
then ExtractText := @(PTestRec(Item)^.Key)
else ExtractText := nil;
end;
{****************************************************************************}
{ TTestRecReader.ExtractIndex }
{****************************************************************************}
function TTestRecReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestRec(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TTestStaticObjectReader object }
{****************************************************************************}
{****************************************************************************}
{ TTestStaticObjectReader.ExtractText }
{****************************************************************************}
function TTestStaticObjectReader.ExtractText(Item : Pointer) : PString;
begin
if Item <> nil
then ExtractText := @(PTestStaticObject(Item)^.Text)
else ExtractText := nil;
end;
{****************************************************************************}
{ TTestStaticObjectReader.ExtractIndex }
{****************************************************************************}
function TTestStaticObjectReader.ExtractIndex(Item : Pointer) : Integer;
begin
if Item <> nil
then ExtractIndex := PTestStaticObject(Item)^.Index
else ExtractIndex := 0;
end;
{****************************************************************************}
{ TStreamSequenceReader object }
{****************************************************************************}
{****************************************************************************}
{ TStreamSequenceReader.GetText }
{****************************************************************************}
function TSequenceReader.GetText(Index : LongInt) : string;
var
Item : Pointer;
StrIndex : string;
begin
if (Container <> nil) and (Index < Container^.Count)
then begin
Item := PSequence(Container)^.At(Index);
Str(Index, StrIndex);
if Item <> nil
then if ExtractText(Item) <> nil
then GetText := ExtractText(Item)^+' ['+StrIndex+']'
else GetText := '['+StrIndex+']'
else GetText := ' nil/deleted'+' ['+StrIndex+']';
Container^.DoneItem(Item);
end { if }
else GetText := '';
end;
{****************************************************************************}
{ TStringReader object }
{****************************************************************************}
{****************************************************************************}
{ TStringReader.ExtractText }
{****************************************************************************}
function TStringReader.ExtractText(Item : Pointer) : PString;
begin
ExtractText := Item;
end;
{****************************************************************************}
{ TStringReader.ExtractIndex }
{****************************************************************************}
function TStringReader.ExtractIndex(Item : Pointer) : Integer;
begin
ExtractIndex := -1;
end;
begin
Packing := False;
end.
